TeX 1995 July/TeX CD-ROM July 1995 (Disc 1)(Walnut Creek)(1995).ISO/graphics/gnuplot/contrib/campbell/gplotlib.2

Internet Message Format | 1992-04-27 | 34.9 KB

From [e-mail] Thu Mar  5 09:26:50 1992
Return-Path: <[e-mail]>
Received: from naucse.cse.nau.edu by ra-next.arc.nasa.gov (NeXT-1.0 (From Sendmail 5.52)/NeXT-1.0)
    id AA10628; Thu, 5 Mar 92 09:26:36 PST
Received: by naucse.cse.nau.edu (5.65c/1.5-nau)
    id AA21531; Thu, 5 Mar 1992 10:32:28 -0700
Message-Id: <[e-mail]>
From: [e-mail] (John Campbell)
Date: Thu, 5 Mar 1992 10:32:27 MST
X-Mailer: Mail User's Shell (7.2.3 5/22/91)
To: [e-mail]
Subject: gplotlib.shr3
Status: R

#! /bin/sh
# This is a shell archive.  Remove anything before this line, then unpack
# it by saving it into a file and typing "sh file".  To overwrite existing
# files, type "sh file -c".  You can also feed this as standard input via
# unshar, or by typing "sh <file", e.g..  If this archive is complete, you
# will see the following message at the end:
#        "End of archive 3 (of 5)."
# Contents:  cpr.c2
# Wrapped by [e-mail] on Tue Feb 11 08:42:15 1992
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f 'cpr.c2' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'cpr.c2'\"
else
echo shar: Extracting \"'cpr.c2'\" \(32782 characters\)
sed "s/^X//" >'cpr.c2' <<'END_OF_FILE'
X
Xchar *
XEndString(p)
Xregister char *p;
X{
X   register char c;
X
X   /*
X         * Always return pointer to last non-null char looked at.
X         */
X   while( c = *p++ )
X      if( c == '\\' && *p )
X      {
X         ++p;
X         continue;
X      }
X      else if( c == '"' )
X      {
X         InString = 0;
X         return(p-1);
X      }
X   return(p-2);
X}
X
XNewFunction()
X{
X   register int i;
X
X   if( Space_to_leave <= 0 || !SawFunction ) return;
X   if( LineNumber + Space_to_leave > (PageLength * PagePart /16) )
X      NewPage();
X   else {
X      for( i=0; i < (Space_to_leave); ++i ) PutString("", -1, 0, 1);
X      LineNumber += Space_to_leave;
X   }
X
X   SawFunction = 0;
X}
X
X#define HEADER_SIZE 3
X
XNewPage()
X{
X   ActualPageCount++;
X   ++PageNumber;
X
X   switch( Printer ) {
X      case POSTSCRIPT:
X     puts( "endpage" );
X     PutHeader();
X     puts( "startpage" );
X     break;
X
X      default:
X     putchar('\f');
X     PutHeader();
X     break;
X   }
X   LineNumber = 0;
X}
X
X
XBlankPage()
X{
X   ActualPageCount++;
X   switch( Printer ) {
X      case POSTSCRIPT:
X     break;
X
X      default:
X     if( LineNumber == 0 ) printf( "   " );
X     putchar('\f');
X     break;
X   }
X   LineNumber = 0;
X}
X
X
XPutHeader()
X{
X   register int l, j;
X   char *lname=Title;
X
X   switch( Printer ) {
X      case POSTSCRIPT:
X     printf( "/pagenum %d def\n", PageNumber );
X     break;
X
X      default:
X     if( lname == NULL ) break;
X     putchar('\n');
X     ++LineNumber;
X
X     l = strlen(lname);
X     printf( "%s", FileDate );
X     j = strlen(FileDate);
X     j = GoToColumn(j, 40-(l/2) );
X
X     PutBold(lname, -1, 0);
X     GoToColumn(j+l, 70);
X     printf("Page:%4d\n\n", PageNumber);
X     ++LineNumber;
X     ++LineNumber;
X     break;
X   }
X}
X
XGoToColumn(from, to)
Xregister int from, to;
X{
X   if( from < to)
X   {
X      for( ; from < to; from++ )
X         putchar(' ');
X   }
X   return( to );
X}
X
X#define isidchr(c)      (isalnum(c) || (c == '_'))
X
X/* This used to incorrectly identify a declaration such as
X *     int (*name[])() = { initializers ... }
X * as a function.  It also picked up this in an assembler file:
X *     #define MACRO(x) stuff
X *     MACRO(x):
X * Fixed both of these.   -IAN!
X */
XLooksLikeFunction(s)
Xregister char *s;
X{
X   register char *p;
X   register int i;
X   char *save;
X
X/* By default this routine does 'C', other languages, other routines. */
X   switch (Language) {
X      case FORTRAN:    return LooksLikeFortran(s);
X      case ICON:       return LooksLikeIcon(s);
X      case LISP:       return LooksLikeLisp(s);
X   }
X
X   if( InComment || InString ) return(0);
X
X   save = s;
X
X   i = 0;
X   do
X      {
X      p = FunctionName;
X
X      while( *s && (*s == ' ') || (*s == '\t') ) ++s;
X      if( *s == '*' ) ++s;
X      if( *s && (*s == ' ') || (*s == '\t') ) continue;
X      if( !*s || ((*s != '_') && !isalpha(*s)) ) return(0);
X
X   /* Store this guess into FunctionName. */
X      while( isidchr(*s) )
X         *p++ = *s++;
X      *p = '\0';
X
X      while( *s && (*s == ' ') || (*s == '\t') ) ++s;
X      i++;
X   }
X   while ( *s && *s != '(' && i < 4 );
X
X   if( *s != '(' || *(s+1) == '*' ) return(0);
X
X   for (i = 0; *s; s++)
X   {
X      switch( *s )
X      {
X      case '(':
X         ++i;
X         continue;
X
X      case ')':
X         --i;
X         break;
X
X      default:
X         break;
X      }
X      if( i == 0 ) break;
X   }
X   if( !*s ) return(0);
X
X   while( *s )
X   {
X      if( *s == '{') break;
X      if( *s == ';' || *s == ':' ) return(0);
X      ++s;
X   }
X   /* Don't match macro definitions (terminated with \) */
X   if (s > save + 3 && (*(s-2) == '\\' ||
X                 (*s == '{' && save[strlen(save)-2] == '\\')))
X       return 0;
X   /*
X      This finds the function name (again) and causes it to be bolded.
X      Note that this assumes the name and opening parentheses are on the
X      same line...  (Note also that FunctionName and what we find here are
X      done by two different mechanisms, why?  JDC)
X   */
X   if (p = strchr( save, '(' ) ) {
X      p--;
X      while (p != save && (*p == ' ' || *p == '\t')) --p;
X      for (i=1; p != save && isidchr(*p); i++) p--;
X
X   /* p now points to a string that is 'i' long that needs to be bolded. */
X      if (p > save)
X         PutString (save, p-save, NumberFlag, 0);
X      PutBold (p, i, 1);
X      p += i;
X      PutString (p, -1, 0, 1);
X   }
X   else
X      PutString (save, -1, NumberFlag, 1);
X
X   SawFunction = 1;
X   return(1);
X}
X
X
Xint LooksLikeFortran(str)
Xchar *str;
X{
X   register char *p, *s=str;
X   register int i;
X   char *save;
X   int  offset = 0;
X
X/* Ignore comment or labeled lines (and be stupid about strings) */
X   if (*s != ' ' && *s != '\t') return(0);
X
X   save = s;
X
X   i = 0;
X/*
X      Fortran is easier than 'C', just check if the first word is
X      SUBROUTINE, FUNCTION or PROGRAM (for those who use this on some systems)
X*/
X   while (*s == ' ' || *s == '\t') ++s;  /* Skip white space */
X
X/* SUBROUTINE, FUNCTION, or PROGRAM lines must start with S, F, or P */
X
X   switch (*s) {
X   case 's':
X   case 'S':
X      offset = Compare (s, "SUBROUTINE");
X   break;
X   case 'F':
X   case 'f':
X      offset = Compare (s, "FUNCTION");
X   break;
X   case 'P':
X   case 'p':
X      offset = Compare (s, "PROGRAM");
X   break;
X   }
X   if (offset == 0) {
X   /*
X      Still a chance that this line is INTEGER FUNCTION or some such.
X      (Second Word is "FUNCTION", No legal keyword or type contains
X      an "F", thank goodness.)
X   */
X      while (*s && *s != 'F' && *s != 'f' && *s != '"') ++s;
X      if (!*s)
X         return 0;
X      offset = Compare (s, "FUNCTION");
X      if (!offset)
X         return 0;
X   }
X   p = s + offset;
X
X   /* p now points to a string that is the subroutine or function name. */
X   for (i=0; isidchr(p[i]); ++i)
X      FunctionName[i] = p[i];
X   FunctionName[i] = '\0';
X
X   /* i is the length of the function name that needs to be bolded. */
X   if (p > save)
X      PutString (save, p-save, NumberFlag, 0);
X   PutBold (p, i, 1);
X   PutString (p+i, -1, NumberFlag, 1);
X
X   SawFunction = 1;
X   Braces = 1;  /* Indicate we are in the scope of a routine (inside). */
X   return(1);
X}
X
X
Xint LooksLikeIcon(str)
Xchar *str;
X{
X   register char *p, *s=str;
X   register int i;
X   char *save;
X
X   save = s;
X   i    = 0;
X
X/* For Icon, just check if the first word is ``procedure'' */
X   while (*s == ' ' || *s == '\t') ++s;  /* Skip white space */
X
X   if (s[0] != 'p' || strncmp (s, "procedure", 9) != 0)
X      return 0;
X
X   p = s + 9;  /* Point to character after ``procedure'' */
X   while (*p == ' ' || *p == '\t') ++p;  /* Skip white space */
X
X/* p now points to a string that is the procedure name. */
X   for (i=0; isidchr(p[i]); ++i)
X      FunctionName[i] = p[i];
X   FunctionName[i] = '\0';
X
X/* i is the length of the procedure name that needs to be bolded. */
X   if (p > save)
X      PutString (save, p-save, NumberFlag, 0);
X   PutBold (p, i, 1);
X   PutString (p+i, -1, NumberFlag, 1);
X
X   SawFunction = 1;
X   Braces = 1;  /* Indicate we are in the scope of a routine (inside). */
X   return(1);
X}
X
Xint LooksLikeLisp(str)
Xchar *str;
X{
X#define MAXLDEPTH 32
X   register char *p, *s = str;
X   register int i;
X   char *fend;
X   static int plevel = 0, fcount = -1, flevel[MAXLDEPTH], endseen = 0;
X   int  offset = 0, fseen = 0;
X/*
X   Lisp is a little harder than some others (perhaps indicating we should
X   rework the whole program...)  In order to handle nested definitions and
X   definitions appearing on the same line we need to restrict scanning of
X   input (in order to preserve state information) to one routine.  Hence,
X   Scan() is not used for Lisp and this routine needs to remember that
X   return (1) implies line was printed and AddToTableOfContents() will
X   be called while return (0) implies line will be printed.
X
X   We also have to call NewFunction ourselves (and after the line closing
X   the function definition has been printed).
X*/
X
X   if (endseen) {
X      NewFunction ();
X      endseen = 0;
X   }
X
X   for (fend = s; *s != '\n'; ++s) {
X      switch (*s) {
X      case ';':    /* Rest of line is a comment. */
X         goto comment_seen;  /* So I used a goto, shoot me. */
X      case '/':    /* Maybe... */
X         if (s[1] == '/') goto comment_seen;
X      case '(':
X      case '[':
X         ++plevel;
X      break;
X      case ')':
X         if (fcount >= 0 && plevel == flevel[fcount]) {
X            if (--fcount < 0) fcount = -1;
X            endseen = 1;
X         }
X         --plevel;
X      break;
X      case ']':
X         if (fcount >= 0) {
X            if (--fcount < 0)  {
X               fcount = -1;
X               plevel = 0;
X            }
X            else
X               plevel = flevel[fcount];
X         }
X         endseen = 1;
X      break;
X      case 'D':
X      case 'd':
X         if (offset = Compare (s, "DEFUN")) {
X            if (fseen) {
X            /* Take care of the other function we found on this line. */
X               AddToTableOfContents(NEWFUNCTION);
X            }
X            p = s + offset;
X         /*
X            Be pretty lax about lisp identifiers (as opposed to 'C').
X            This doesn't look safe, but \n is a space character.
X         */
X            for (i = 0; !isspace(p[i]) && p[i] != '('; ++i)
X               FunctionName[i] = p[i];
X            FunctionName[i] = '\0';
X            if (p > fend)
X               PutString (fend, p-fend, NumberFlag, 0);  /* Front part. */
X            PutBold (p, i, 1);
X            fend = p+i;
X            if (++fcount > MAXLDEPTH) {
X               fprintf (stderr, "Function defuns nested too deep\n");
X               --fcount;
X            }
X            flevel[fcount] = plevel;
X            fseen = 1;
X         }
X      break;
X      }  /* switch */
X   }  /* while */
X
Xcomment_seen:
X   if (fseen) {
X      PutString (fend, -1, NumberFlag, 1);  /* End of string part. */
X      SawFunction = 1;
X      return 1;
X   }
X   return 0;
X}
X
X
Xstatic int Compare (str, key)
Xchar *str, *key;
X/* Return the start (in s) of the next word (0 relative offest) if the
X   key matches.  ``key'' must be in upper case. Otherwise return 0.
X*/
X{
X   register char *s=str, *k=key;
X   int c;
X
X   do {
X      ++s, ++k;
X      c = *s;
X      if (islower(c)) c = toupper (c);
X   } while (c == *k);
X
X   if (*k != '\0') return 0;
X/*
X   Now skip to the start of the next word;
X*/
X   while (*s && (*s == ' ' || *s == '\t')) ++s;
X
X   if (*s == '\0') return 0;
X
X   return s - str;  /* Offset of next word (to be bolded) */
X}
X
XAddToTableOfContents(type)
X{
X   if( TocCount > TOC_SIZE )
X      return;
X   if( TocCount == TOC_SIZE )
X   {
X      fprintf(stderr, "%s: More than %d Table of contents entries; others ignored.\n",
X      ProgName, TOC_SIZE);
X      ++TocCount;
X      return;
X   }
X
X   if( type == NEWFILE )
X      AddFile();
X   else
X      AddFunction();
X}
X
XAddFunction()
X{
X   register int l;
X   register char *p;
X
X   /* This heuristic stops multiple occurrences of a function,
X         * selected by #ifdefs, to all end up many times over in the
X         * Table of Contents.  One only needs to see it once.  -IAN!
X         */
X   if( TocCount > 0 && TocPages[TocCount-1] == PageNumber
X      && strcmp(Toc[TocCount-1],FunctionName) == 0 )
X      return;
X   l = strlen(FunctionName);
X   if( l >40 ) l = 40;
X   p = Toc[TocCount] = (char *)malloc(l+1);
X   strncpy(p, FunctionName, l);
X   p[l] = '\0';
X   TocPages[TocCount] = PageNumber;
X   ++TocCount;
X}
X
XAddFile()
X{
X   register int l;
X   register int len;
X   char temp[20];
X#define MAXFNLEN 59+17  /* Room for 3 dots (...) */
X
X   len = strlen(Name) + 20;
X   Toc[TocCount] = (char *)malloc(130);
X   if (len > MAXFNLEN)
X      sprintf(Toc[TocCount], "\n    File: ...%s ", &Name[len-MAXFNLEN-16]);
X   else
X      sprintf(Toc[TocCount], "\n    File: %s ", Name);
X   l = strlen(Toc[TocCount]);
X   if( l < 64 )
X   {
X      while( l < 64 )
X         Toc[TocCount][l++] = ' ';
X
X      Toc[TocCount][l++] = '\0';
X   }
X   sprintf(temp, "  Page %4d\n", PageNumber);
X   strcat(Toc[TocCount], temp);
X   ++TocCount;
X}
X
X#define MAXNAME    30
XNewFile( reset )
Xint reset;
X{
X   static first = 1;
X   static char buf[45];
X
X   if( reset )
X      first = 1;
X   else
X      GetFileTime();
X
X   if( strlen(Name) > MAXNAME ) {
X      strcpy( buf, "... " );
X      strcat( buf, Name+strlen(Name)-MAXNAME-4 );
X      Title = buf;
X   }
X   else
X      Title = Name;
X
X   if( ResetPage ) PageNumber=1;
X
X   switch( Printer ) {
X      case POSTSCRIPT:
X     if( !first && !ResetPage ) PageNumber++;
X     if( !first ) puts( "endpage" );
X     printf( "(%s) setdate\n", FileDate );
X     printf( "(%s) newfile\n", Title );
X     puts( "/sheet 1 def" );
X     printf( "/pagenum %d def\n", PageNumber );
X     puts( "startpage" );
X     break;
X
X      default:
X     if( first )
X        PutHeader();
X     else {
X        BlankPage();
X        if( StartOdd && (ActualPageCount % 2) != 0 ) BlankPage();
X        if( !ResetPage ) PageNumber++;
X        PutHeader();
X     }
X
X     break;
X   }
X
X   first = 0;
X   AddToTableOfContents(NEWFILE);
X   FileLineNumber = 0;
X}
X
X
XGetFileTime()
X{
X   struct stat st;
X   extern char *ctime();
X
X   if( File == NULL ) return;
X
X   if( File == stdin )
X      strncpy(FileDate, &Today[4], 20);
X   else
X      {
X      fstat(fileno(File), &st);
X      strncpy(FileDate, ctime((time_t *)&st.st_mtime) + 4, 20);
X   }
X   strncpy(&FileDate[12], &FileDate[15], 5);
X   FileDate[17] = '\0';
X}
X
XDumpTableOfContents()
X{
X   register int i, j;
X   int index[TOC_SIZE];
X   char buf[200];
X
X   if( TocCount == 0 ) return;
X
X   for (i = 0; i < TocCount; i++) index[i] = i;
X   if( SortFlag )
X      SortTable(index);
X
X   File = NULL;
X   Name = "Table of Contents";
X   FileDate = Today;
X   ActualPageCount = 0;
X   PageNumber = 1;
X   LineNumber = 0;
X   NewFile(1);
X
X   if( TitleFile != NULL )
X   {
X      FILE *f;
X      char b[MAXLINE];
X
X      if( (f=fopen(TitleFile,"r")) == NULL ) {
X         CANT_OPEN (TitleFile);
X      }
X      else
X      {
X         while( fgets(b, MAXLINE, f) != NULL )
X         {
X            if( strlen(b) ) b[strlen(b)-1]=0;
X            PutString(b, -1, 0, 1);
X            LineNumber++;
X            if( ++LineNumber >= PageEnd ) NewPage();
X         }
X
X         fclose(f);
X      }
X      NewPage();
X   }
X
X   TocCount--; /* Bumped by NewFile for TOC */
X   for( i=0; i < TocCount; ++i ) {
X      char *s;
X
X      if( Toc[index[i]][0] == '\n' ) {
X         if( (LineNumber + 5) >= PageEnd ) NewPage();
X
X     PutString("", -1, 0, 1);
X     PutString(Toc[index[i]]+1, -1, 0, 1);
X         LineNumber += 2;
X         continue;
X      }
X      ++LineNumber;
X      if( LineNumber >= PageEnd && (i+1) != TocCount ) NewPage();
X
X      sprintf(buf, "        %s ", Toc[index[i]]);
X      s = buf+strlen(buf);
X      for( j=strlen(Toc[index[i]]); j < 48; ++j ) *s++ = '.';
X      *s++ = '\0';
X      sprintf( buf, "%s %4d", buf, TocPages[index[i]]);
X      PutString(buf, -1, 0, 1);
X   }
X
X   if( Printer == POSTSCRIPT )
X      puts( "endpage" );
X   else {
X      BlankPage();
X      if( StartOdd && ((ActualPageCount % 2) != 0) ) BlankPage();
X   }
X}
X
XSortTable(index)
Xregister int *index;
X{
X   register int i, temp, flag;
X   char name1[MAXLINE];
X   char name2[MAXLINE];
X
X   do {
X      flag = 0;
X      for (i = 0; i < TocCount - 1; i++)
X      {
X         if( Toc[index[i]][0] == '\n' || Toc[index[i+1]][0] == '\n' )
X            continue; /* don't sort across file names */
X         strcpy( name1, Toc[index[i]] );
X         strcpy( name2, Toc[index[i+1]] );
X
X         if( CaseInsensitive )
X         {
X            char *p;
X            char c;
X            for(p = name1; c = *p; p++ )
X               if( islower(c) ) *p=toupper(c);
X            for(p = name2; c = *p; p++ )
X               if( islower(c) ) *p=toupper(c);
X         }
X
X         if( strcmp(name1, name2) > 0)
X         {
X            temp = index[i];
X            index[i] = index[i+1];
X            index[i+1] = temp;
X            flag = 1;
X         }
X      }
X   }
X   while( flag );
X}
X
Xenum langs WhichLanguage (file_name)
Xchar *file_name;
X/*
X   Routine to return one of the enum languages based on the suffix of
X   the file name.
X*/
X{
X   char *end;
X
X   if (end = strrchr (file_name, '.')) {
X      ++end;  /* Move past the '.' */
X      switch (*end) {
X      case 'C':    /* Allow .c, .C as suffixes (and ;231 for VMS, etc.) */
X      case 'c':
X      case 'Y':    /* And treat YACC as 'C' */
X      case 'y':
X         if (!isalpha(end[1]))
X            return C;
X      break;
X      case 'F':     /* Allow .f, .F, .FOR, .for as suffixes */
X      case 'f':
X         if (!isalpha(end[1]))
X            return FORTRAN;
X
X         if ((end[1] == 'o' || end[1] == 'O') &&
X             (end[2] == 'r' || end[2] == 'R') && !isalpha(end[3]))
X            return FORTRAN;
X      break;
X      case 'I':   /* Allow .icn or .ICN (or even .iCn) as suffixes */
X      case 'i':
X         if ((end[1] == 'c' || end[1] == 'C') &&
X             (end[2] == 'n' || end[2] == 'N') && !isalpha(end[3]))
X            return ICON;
X      break;
X      case 'L':   /* Allow both .lsp and .l */
X      case 'l':
X         if ((end[1] == 's' || end[1] == 'S') &&
X             (end[2] == 'p' || end[2] == 'P') && !isalpha(end[3]))
X            return LISP;
X         if (!isalpha(end[1])) {
X         /*
X            Ok, we have .l for lisp or .l for lex (sigh).  To determine
X            which, read in some lines and look for Lex '%'s or a "/*" or
X            a bunch of lisp comments ';' or starting parens '('.
X         */
X            char buf[256], *ptr;
X            int lcount=0, lisp = 0, lex = 0;
X            while (fgets(buf, MAXLINE, File) != NULL) {
X               ptr = buf;
X               while (*ptr == ' ' || *ptr == '\t') ++ptr;
X               if (*ptr == '\/') {
X                  if (ptr[1] == '\*') {
X                  /* Decisive, a line starts with a 'C' comment. */
X                     lex = lisp + 1;
X                     break;
X                  }
X                  else if (ptr[1] == '\/') {
X                     ++lisp;  /* Lisp type comment seen (//) */
X                  }
X               }
X               else if (*ptr == '%') {
X               /* Decisive, lex requires '%'s to separate sections. */
X                  lex = lisp + 1;
X                  break;
X               }
X               else if (*ptr == '(' || *ptr == ';' || *ptr == '[') {
X               /* Should be tons of these starting lines in lisp programs. */
X                  if (++lisp > 4) {
X                     lisp = lex + 1;
X                     break;
X                  }
X               }
X               if (++lcount > 50) {
X               /* Give up. */
X                  break;
X               }
X            }
X         /* Rewind the file. */
X            fseek (File, 0, 0);
X            if (lisp > lex) return LISP;
X            else return C;  /* Default to treat .l as lex code. */
X         }
X      /* Fall through */
X      }
X   }
X   return NONE;
X}
X
X
XInit (pname)
Xchar *pname;
X/*
X   Routine to select which printer is to be assumed.  Either the default
X   (compiled in), or the environment variable CPRINTER, or the argument
X   line choice.  Possible argument line or CPRINTER variables: "DUMB",
X   "BACKSPACE", "ANSI", etc.  The passed in pointer ``printer'' is from
X   the command line.
X
X   After printer has been selected, anything else that needs to be done
X   to this printer (change pitch etc.) is done here.
X*/
X{
X   char *cprinter, *getenv();
X   char *psheader;
X
X   if ((cprinter = pname) != NULL || (cprinter = getenv("CPRINTER")) != NULL) {
X   /* Figure out what this person wants to use as a cpr printer. */
X      if (strcmp (cprinter, "DUMB") == 0)           Printer = DUMB;
X      else if (strcmp (cprinter, "BACKSPACE") == 0) Printer = BACKSPACE;
X      else if (strcmp (cprinter, "ANSI") == 0)      Printer = ANSI;
X      else if (strcmp (cprinter, "LN03") == 0)      Printer = LN03;
X      else if (strcmp (cprinter, "NECP5200") == 0)  Printer = NECP5200;
X      else if (strcmp (cprinter, "POSTSCRIPT") == 0)Printer = POSTSCRIPT;
X      else {
X         fprintf (stderr, "Unknown printer %s\n", cprinter);
X         exit(1);
X      }
X   }
X   switch (Printer) {
X      case POSTSCRIPT:
X     PageEnd = PageLength;
X     break;
X
X      case NECP5200:
X      /* Setup the NEC P5200 (draft mode, 12 cpi, left margin) */
X     printf ("\033x%c\033!%c\033l%c", 0, 1, 5);
X     /*FALLTHROUGH*/
X
X      default:
X     PageEnd = PageLength - ((PageLength > 30) ? 7 : 1);
X   }
X}
X
X
XFini()
X/*
X   Undo whatever Init() did to the printer, etc.
X*/
X{
X   switch (Printer) {
X      case NECP5200:
X     /* Reset to LQ mode, 10 cpi, left margin to 0 */
X     printf ("\033x%c\033!%c\033l%c", 1, 0, 0);
X     break;
X
X      case POSTSCRIPT:
X     puts("endpage\n\n%%Trailer");
X     puts("cleanup\ndocsave restore end\n");
X     break;
X   }
X}
X
X
XDumpPostscriptHeader()
X{
X   puts("%! a2ps 3.0");
X   puts("");
X   puts("/$a2psdict 100 dict def");
X   puts("$a2psdict begin");
X   puts("% Initialize page description variables.");
X   puts("/inch {72 mul} bind def");
X   puts("/landscape true def");
X   puts("/twinpage true def");
X   puts("/sheetheight 11.64 inch def");
X   puts("/sheetwidth 8.27 inch def");
X   puts("/margin 1.2 inch def");
X   puts("/noborder false def");
X   puts("/noheader false def");
X   puts("/headersize 0.22 inch def");
X   puts("/bodyfontsize 7.5 def");
X   puts("/lines 66 def");
X   puts("/columns 80 def");
X   puts("/datewidth 0 def");
X   puts("%!  PostScript Source Code");
X   puts("%");
X   puts("%  File: imag:/users/local/a2ps/header.ps");
X   puts("%  Created: Tue Nov 29 12:14:02 1988 by miguel@imag (Miguel Santana)");
X   puts("%  Version: 2.0");
X   puts("%  Description: PostScript prolog for a2ps ascii to PostScript program.");
X   puts("% ");
X   puts("%  Edit History:");
X   puts("%  - Original version by evan@csli (Evan Kirshenbaum).");
X   puts("%  - Modified by miguel@imag to:");
X   puts("%    1) Correct an overflow bug when printing page number 10 (operator");
X   puts("%    cvs).");
X   puts("%    2) Define two other variables (sheetwidth, sheetheight) describing");
X   puts("%    the physical page (by default A4 format).");
X   puts("%    3) Minor changes (reorganization, comments, etc).");
X   puts("%  - Modified by [e-mail]");
X   puts("%    1) Correct stack overflows with regard to operators cvs and copy.");
X   puts("%       The resulting substrings where in some cases not popped off");
X   puts("%       the stack, what can result in a stack overflow.");
X   puts("%    2) Replaced copypage and erasepage by showpage. Page througput");
X   puts("%       degrades severely (see red book page 140) on our ps-printer");
X   puts("%       after printing sheet 16 (i.e. page 8) of a file which was ");
X   puts("%       actually bigger. For this purpose the definitions of startdoc");
X   puts("%       and startpage are changed.");
X   puts("%  - Modified by Tim Clark <[e-mail]> to:");
X   puts("%    1) Print one page per sheet (portrait) as an option.");
X   puts("%    2) Reduce size of file name heading, if it's too big.");
X   puts("%    3) Save and restore PostScript state at begining/end. It now uses");
X   puts("%    conventional %%Page %%Trailer markers.");
X   puts("%    4) Print one wide page per sheet in landscape mode as an option.");
X   puts("%  - Modified by [e-mail] to");
X   puts("%    1) Add new option to print n copies of a file.");
X   puts("%    2) Add new option to suppress heading printing.");
X   puts("%    3) Add new option to suppress page surrounding border printing.");
X   puts("%    4) Add new option to change font size. Number of lines and columns");
X   puts("%    are now automatically adjusted, depending on font size and");
X   puts("%    printing mode used.");
X   puts("%    5) Minor changes (best layout, usage message, etc).");
X   puts("%");
X   puts("");
X   puts("% Copyright (c) 1988, Miguel Santana, [e-mail]");
X   puts("%");
X   puts("% Permission is granted to copy and distribute this file in modified");
X   puts("% or unmodified form, for noncommercial use, provided (a) this copyright");
X   puts("% notice is preserved, (b) no attempt is made to restrict redistribution");
X   puts("% of this file, and (c) this file is not distributed as part of any");
X   puts("% collection whose redistribution is restricted by a compilation copyright.");
X   puts("%");
X   puts("");
X   puts("");
X   puts("% General macros.");
X   puts("/xdef {exch def} bind def");
X   puts("/getfont {exch findfont exch scalefont} bind def");
X   puts("");
X   puts("% Page description variables and inch function are defined by a2ps program.");
X   puts("");
X   puts("% Character size for differents fonts.");
X   puts("   landscape");
X   puts("   { /filenamefontsize bodyfontsize 1.5 mul def }");
X   puts("   { /filenamefontsize bodyfontsize 1.5 mul 16 def }");
X   puts("ifelse");
X   puts("/datefontsize filenamefontsize 0.6 mul def");
X   puts("/headermargin filenamefontsize 0.25 mul def");
X   puts("/bodymargin bodyfontsize 0.7 mul def");
X   puts("");
X   puts("% Font assignment to differents kinds of \"objects\"");
X   puts("/filenamefontname /Helvetica-Bold def");
X   puts("/stdfilenamefont filenamefontname filenamefontsize getfont def");
X   puts("/datefont /Helvetica-Oblique datefontsize getfont def");
X   puts("/bodyfont /Courier bodyfontsize getfont def");
X   puts("/boldbodyfont /Courier-Bold bodyfontsize getfont def");
X   puts("");
X   puts("% Logical page attributes (a half of a real page or sheet).");
X   puts("/pagewidth");
X   puts("   bodyfont setfont (0) stringwidth pop columns mul bodymargin dup add add");
X   puts("   def");
X   puts("/pageheight");
X   puts("   bodyfontsize lines mul bodymargin dup add add headersize add");
X   puts("   def");
X   puts("");
X   puts("% Coordinates for upper corner of a logical page and for sheet number.");
X   puts("% Coordinates depend on format mode used.");
X   puts("% In twinpage mode, coordinate x of upper corner is not the same for left");
X   puts("% and right pages: upperx is an array of two elements, indexed by sheetside.");
X   puts("/rightmargin margin 4 div def");
X   puts("/leftmargin margin 3 mul 4 div def");
X   puts("/topmargin margin twinpage {3.6} {2} ifelse div def");
X   puts("landscape");
X   puts("{  % Landscape format");
X   puts("   /uppery rightmargin pageheight add bodymargin add def");
X   puts("   /sheetnumbery sheetwidth leftmargin pageheight add datefontsize add sub def");
X   puts("   twinpage");
X   puts("   {  % Two logical pages");
X   puts("      /upperx [ topmargin            % upperx for left page");
X   puts("        dup 2 mul pagewidth add        % upperx for right page");
X   puts("          ] def");
X   puts("      /sheetnumberx sheetheight topmargin sub def");
X   puts("   }");
X   puts("   {  /upperx [ topmargin dup ] def");
X   puts("      /sheetnumberx sheetheight topmargin sub datefontsize sub def");
X   puts("   }");
X   puts("   ifelse");
X   puts("}");
X   puts("{  % Portrait format");
X   puts("   /uppery topmargin pageheight add def");
X   puts("   /upperx [ leftmargin dup ] def");
X   puts("   /sheetnumberx sheetwidth rightmargin sub datefontsize sub def");
X   puts("   /sheetnumbery");
X   puts("     sheetheight ");
X   puts("     topmargin pageheight add datefontsize add headermargin add");
X   puts("      sub");
X   puts("      def");
X   puts("");
X   puts("}");
X   puts("ifelse");
X   puts("");
X   puts("% Strings used to make easy printing numbers");
X   puts("/pnum 12 string def");
X   puts("/empty 12 string def");
X   puts("");
X   puts("% Other initializations.");
X   puts("/setdate");
X   puts("{" );
X   puts("/date exch def" );
X   puts("/datewidth date stringwidth pop def");
X   puts("filenameroom");
X   puts("} def\n");
X   puts("/filenameroom {");
X   puts("         pagewidth");
X   puts("     filenamefontsize 4 mul datewidth add (Page 9999) stringwidth pop add");
X   puts("      sub");
X   puts("   } def");
X   puts("");
X   puts("");
X   puts("% Function startdoc: initializes printer and global variables.");
X   puts("/startdoc");
X   puts("    { /sheetside 0 def            % sheet side that contains current page");
X   puts("      /sheet 1 def            % sheet number");
X   puts("   } bind def");
X   puts("");
X   puts("% Function newfile: init file name and reset page number for each new file.");
X   puts("/newfile");
X   puts("    { cleanup");
X   puts("      /filename xdef");
X   puts("      /filenamewidth filename stringwidth pop def");
X   puts("      /filenamefont");
X   puts("     filenamewidth filenameroom gt");
X   puts("     {");
X   puts("           filenamefontname");
X   puts("           filenamefontsize filenameroom mul filenamewidth div");
X   puts("        getfont");
X   puts("     }");
X   puts("     {  stdfilenamefont }");
X   puts("     ifelse");
X   puts("     def");
X   puts("    } bind def");
X   puts("");
X   puts("% Function printpage: Print a physical page.");
X   puts("/printpage");
X   puts("    { /sheetside 0 def");
X   puts("      twinpage");
X   puts("      {  noborder not");
X   puts("        { sheetnumber }");
X   puts("     if");
X   puts("      }");
X   puts("      {  noheader noborder not and");
X   puts("        { sheetnumber }");
X   puts("     if");
X   puts("      }");
X   puts("      ifelse");
X   puts("      showpage ");
X   puts("%      pagesave restore");
X   puts("      /sheet sheet 1 add def");
X   puts("    } bind def");
X   puts("");
X   puts("% Function cleanup: terminates printing, flushing last page if necessary.");
X   puts("/cleanup");
X   puts("    { twinpage sheetside 1 eq and");
X   puts("         { printpage }");
X   puts("      if");
X   puts("    } bind def");
X   puts("");
X   puts("% Function startpage: prints page header and page border and initializes");
X   puts("% printing of the file lines.");
X   puts("/startpage");
X   puts("    { sheetside 0 eq");
X   puts("    { % /pagesave save def");
X   puts("      landscape");
X   puts("        { sheetwidth 0 inch translate    % new coordinates system origin");
X   puts("          90 rotate                % landscape format");
X   puts("        } if");
X   puts("    } if");
X   puts("      noborder not { printborder } if");
X   puts("      noheader not { printheader } if");
X   puts("     upperx sheetside get  bodymargin  add");
X   puts("        uppery");
X   puts("        bodymargin bodyfontsize add  noheader {0} {headersize} ifelse add");
X   puts("     sub");
X   puts("      moveto");
X   puts("      bodyfont setfont");
X   puts("      gsave");
X   puts("    } bind def");
X   puts("");
X   puts("% Function printheader: prints page header.");
X   puts("/printheader");
X   puts("    { upperx sheetside get  uppery headersize sub 1 add  moveto");
X   puts("      datefont setfont");
X   puts("      gsave");
X   puts("        datefontsize headermargin rmoveto");
X   puts("    date show                    % date/hour");
X   puts("      grestore");
X   puts("      gsave");
X   puts("    pagenum pnum cvs pop");
X   puts("       pagewidth (Page 999) stringwidth pop sub");
X   puts("       headermargin");
X   puts("    rmoveto");
X   puts("        (Page ) show pnum show                % page number");
X   puts("      grestore");
X   puts("      empty pnum copy pop");
X   puts("      gsave");
X   puts("        filenamefont setfont");
X   puts("          filenameroom filename stringwidth pop sub 2 div datewidth add");
X   puts("          bodymargin 2 mul ");
X   puts("       add ");
X   puts("       headermargin");
X   puts("    rmoveto");
X   puts("        filename show                        % file name");
X   puts("      grestore");
X   puts("    } bind def");
X   puts("");
X   puts("% Function printborder: prints border page.");
X   puts("/printborder ");
X   puts("    { upperx sheetside get uppery moveto");
X   puts("      gsave                    % print the four sides");
X   puts("        pagewidth 0 rlineto            % of the square");
X   puts("        0 pageheight neg rlineto");
X   puts("        pagewidth neg 0 rlineto");
X   puts("        closepath stroke");
X   puts("      grestore");
X   puts("      noheader not");
X   puts("         { 0 headersize neg rmoveto pagewidth 0 rlineto stroke }");
X   puts("      if");
X   puts("    } bind def");
X   puts("");
X   puts("% Function endpage: adds a sheet number to the page (footnote) and prints");
X   puts("% the formatted page (physical impression). Activated at the end of each");
X   puts("% source page (lines reached or FF character).");
X   puts("/endpage {");
X   puts("     grestore");
X   puts("     /pagenum pagenum 1 add def");
X   puts("     twinpage  sheetside 0 eq  and");
X   puts("        { /sheetside 1 def }");
X   puts("        { printpage }");
X   puts("     ifelse");
X   puts("   } bind def");
X   puts("");
X   puts("% Function sheetnumber: prints the sheet number.");
X   puts("/sheetnumber");
X   puts("    { sheetnumberx sheetnumbery moveto");
X   puts("      datefont setfont");
X   puts("      sheet pnum cvs");
X   puts("     dup stringwidth pop (0) stringwidth pop sub neg 0 rmoveto show");
X   puts("      empty pnum copy pop");
X   puts("    } bind def");
X   puts("");
X   puts("% Function s: print a source line");
X   puts("/newline {");
X   puts("    grestore");
X   puts("    0 bodyfontsize neg rmoveto");
X   puts("    gsave");
X   puts("} bind def");
X   puts("/s  { show");
X   puts("      newline");
X   puts("    } bind def");
X   puts("/sb  {");
X   puts("        boldbodyfont setfont");
X   puts("        show");
X   puts("     bodyfont setfont");
X   puts("    } bind def");
X   puts("/sn  {");
X   puts("        show");
X   puts("    } bind def");
X   puts("%%EndProlog");
X   puts("\n\n/docsave save def\nstartdoc\n");
X}
END_OF_FILE
if test 32782 -ne `wc -c <'cpr.c2'`; then
    echo shar: \"'cpr.c2'\" unpacked with wrong size!
fi
# end of 'cpr.c2'
fi
echo shar: End of archive 3 \(of 5\).
cp /dev/null ark3isdone
MISSING=""
for I in 1 2 3 4 5 ; do
    if test ! -f ark${I}isdone ; then
    MISSING="${MISSING} ${I}"
    fi
done
if test "${MISSING}" = "" ; then
    echo You have unpacked all 5 archives.
    rm -f ark[1-9]isdone
else
    echo You still need to unpack the following archives:
    echo "        " ${MISSING}
fi
##  End of shell archive.
exit 0